Chip 1996 September/CHIP 1996 szeptember (CD07).zip/CHIP_CD07.ISO/sac/pack/bitlin.lzh/BITSCR.LZH/GETFILE.FRM

Text File | 1995-05-23 | 9KB | 393 lines

VERSION 2.00
Begin Form frmGetFile
   AutoRedraw      =   -1  'True
   Caption         =   "Select a file"
   Height          =   4575
   Left            =   2325
   LinkTopic       =   "Form1"
   ScaleHeight     =   4170
   ScaleWidth      =   6225
   Top             =   1095
   Width           =   6345
   Begin TextBox txtWidth
      Height          =   285
      Left            =   5520
      TabIndex        =   17
      Top             =   1800
      Width           =   615
   End
   Begin TextBox txtHeight
      Height          =   285
      Left            =   5520
      TabIndex        =   16
      Top             =   1440
      Width           =   615
   End
   Begin PictureBox picFile2
      Height          =   615
      Left            =   6360
      Picture         =   GETFILE.FRX:0000
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   13
      Top             =   840
      Width           =   495
   End
   Begin PictureBox PicFile1
      Height          =   615
      Left            =   6360
      Picture         =   GETFILE.FRX:0302
      ScaleHeight     =   585
      ScaleWidth      =   465
      TabIndex        =   12
      Top             =   120
      Width           =   495
   End
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   495
      Left            =   4920
      TabIndex        =   11
      Top             =   720
      Width           =   1095
   End
   Begin CommandButton cmdOK
      Caption         =   "&OK"
      Height          =   495
      Left            =   4920
      TabIndex        =   10
      Top             =   120
      Width           =   1095
   End
   Begin DirListBox dirDirectory
      Height          =   2280
      Left            =   2640
      TabIndex        =   9
      Top             =   720
      Width           =   2175
   End
   Begin DriveListBox drvDrive
      Height          =   315
      Left            =   2640
      TabIndex        =   5
      Top             =   3600
      Width           =   2295
   End
   Begin ComboBox cboFileType
      Height          =   300
      Left            =   240
      Style           =   2  'âhâìâbâv â_âEâô âèâXâg
      TabIndex        =   4
      Top             =   3600
      Width           =   2175
   End
   Begin FileListBox filFiles
      Height          =   2370
      Hidden          =   -1  'True
      Left            =   240
      TabIndex        =   2
      Top             =   720
      Width           =   2175
   End
   Begin TextBox txtFileName
      Height          =   285
      Left            =   240
      TabIndex        =   1
      Top             =   360
      Width           =   2175
   End
   Begin Label lblWidth
      Caption         =   "Width:"
      Height          =   255
      Left            =   4920
      TabIndex        =   15
      Top             =   1800
      Width           =   615
   End
   Begin Label lblHeight
      Caption         =   "Height:"
      Height          =   255
      Left            =   4920
      TabIndex        =   14
      Top             =   1440
      Width           =   615
   End
   Begin Image imgSample
      BorderStyle     =   1  'Ä└Éⁿ
      Height          =   1335
      Left            =   4920
      Top             =   2160
      Width           =   1215
   End
   Begin Label lblDirName
      Height          =   255
      Left            =   2640
      TabIndex        =   8
      Top             =   360
      Width           =   1455
   End
   Begin Label lblDirectories
      Caption         =   "Directories:"
      Height          =   255
      Left            =   2640
      TabIndex        =   7
      Top             =   120
      Width           =   975
   End
   Begin Label lbDrive
      Caption         =   "Drive:"
      Height          =   255
      Left            =   2640
      TabIndex        =   6
      Top             =   3360
      Width           =   975
   End
   Begin Label lblFileType
      Caption         =   "File Type:"
      Height          =   255
      Left            =   240
      TabIndex        =   3
      Top             =   3360
      Width           =   735
   End
   Begin Label lblFileName
      Caption         =   "File Name:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   855
   End
End
Dim LZHstatus
Dim LZHname

Sub cboFileType_Click ()

Dim patternpos1 As Integer
Dim patternpos2 As Integer
Dim patternlen As Integer
Dim Pattern As String

'Find starting position
patternpos1 = InStr(1, cbofiletype.Text, "(") + 1

'Find the end position
patternpos2 = InStr(1, cbofiletype.Text, ")") - 1

'Calculate the length of the pattern string
patternlen = patternpos2 - patternpos1 + 1

'Extract the pattern from the combo box
Pattern = Mid$(cbofiletype.Text, patternpos1, patternlen)

'set the pattern of the filfiles to the select pattern
filFiles.Pattern = Pattern


End Sub

Sub cmdCancel_Click ()

'Set the frmgetfile.tag to null
frmGetFile.Tag = ""

'Hide the frmgetfile
frmlha.Hide
frmGetFile.Hide

End Sub

Sub cmdDelete_Click ()

If txtFileName.Text = "" Then
  Exit Sub
End If

'Insert drive and path name
procInsPath

'Delete file
Kill frmGetFile.Tag
txtFileName.Text = ""

'Update file list
filFiles.Refresh

End Sub

Sub cmdDelete_DragDrop (Source As Control, X As Single, Y As Single)

cmdDelete_Click

End Sub

Sub cmdDelete_DragOver (Source As Control, X As Single, Y As Single, state As Integer)

Select Case state
  Case 0
    'change icon to release
     filFiles.DragIcon = picFile2
  Case 1
    'change icon to release
     filFiles.DragIcon = picFile1
End Select

End Sub

Sub cmdOK_Click ()

Dim pathandname As String
Dim Path

'if no file is selected, exit this procedure
If txtFileName.Text = "" Then
  Exit Sub
End If

'Insert path name
procInsPath

'Hide frmgetfile
frmGetFile.Hide

End Sub

Sub dirDirectory_Change ()

'Change the path of the file list box
filFiles.Path = dirDirectory.Path

'Update lblDirName
lblDirName.Caption = dirDirectory.Path

End Sub

Sub dirDirectory_KeyPress (KeyAscii As Integer)

If KeyAscii = 13 Then
 'Change path
 dirDirectory.Path = dirDirectory.List(dirDirectory.ListIndex)
End If

End Sub

Sub DisplaySample ()

'Insert full path
procInsPath

'Display picture
imgSample.Picture = LoadPicture(frmGetFile.Tag)

'Display size
txtWidth.Text = imgSample.Width / screen.TwipsPerPixelX
txtHeight.Text = imgSample.Height / screen.TwipsPerPixelY

'if BMP too large then cut it off
If imgSample.Width > 1215 Then
  imgSample.Width = 1215
  txtWidth.Text = txtWidth.Text + "+"
End If
If imgSample.Height > 1335 Then
  imgSample.Height = 1335
  txtHeight.Text = txtHeight.Text + "+"
End If

End Sub

Sub drvDrive_Change ()

'Set Error trap
On Error GoTo DriveError

'Change the path of the directory list box to new drive
dirDirectory.Path = drvDrive.Drive
Exit Sub

'Error routine
DriveError:
'Restore to the original drive
MsgBox "Drive error!", 48, "Error"
drvDrive.Drive = dirDirectory.Path
Exit Sub

End Sub

Sub filFiles_Click ()

'Update the txtFileName text box
txtFileName = filFiles.FileName

End Sub

'Copyright 1995  by Hitoshi Ozawa
Sub filFiles_DblClick ()

'If it is a LHA file, open frmlha
If Right$(filFiles.FileName, 3) = "lzh" Then
 'Save file name in fname variable
 procInsPath
 frmlha.Show 1
 filFiles.FileName = frmlha.Tag

 Exit Sub
End If

'Update the txtfilename text box with selected file name
txtFileName = filFiles.FileName

'Display BMP file in imgSample
DisplaySample

End Sub

Sub filFiles_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)

'Change drag icon
filFiles.DragIcon = picFile1

'Enable drag
filFiles.Drag

End Sub

Sub Form_Load ()

'Update the Directory lblDir Name with the path of directory list box
lblDirName.Caption = dirDirectory.Path

End Sub

Sub imgSample_DragDrop (Source As Control, X As Single, Y As Single)

DisplaySample

End Sub

Sub imgSample_DragOver (Source As Control, X As Single, Y As Single, state As Integer)

Select Case state
  Case 0
    'change icon when over
    filFiles.DragIcon = picFile2
  Case 1
    'change icon to release
    filFiles.DragIcon = picFile1
End Select

End Sub

Sub txtFileName_KeyPress (KeyAscii As Integer)

If KeyAscii = 13 Then
  If (InStr(txtFileName.Text, "*") <> 0) Or (InStr(txtFileName.Text, "?") <> 0) Then
    'set the pattern of the filfiles to the select pattern
    filFiles.Pattern = txtFileName.Text
  End If
End If

End Sub